unit cx_http;
{}
interface

uses
 m_api, m_globaldefs, cx_vars;

//function httpget(host : string; port : integer; path : string) : string;

procedure HTTP_NL_Init();
function HTTP_NL_Get(szUrl: String; szRequestType: Integer = REQUEST_GET): String;
procedure HTTP_NL_Close();

implementation

uses
Dialogs, SysUtils, {IdHTTP, }StrUtils, DateUtils;

{
function httpget(host : string; port : integer; path : string) : string;
var
  HTTP : TIdHTTP;
  //response : String;
begin
  result:='';
  HTTP:=TIdHTTP.Create(nil);
  HTTP.Host:=host;
  HTTP.Port:=Port;
  HTTP.HandleRedirects:=True;
  cx_Tomorrow:=IncWeek(cx_Today,1);
  cx_Today := Today;
  cx_DateFrom := IncWeek(cx_Today,-2);
  DateTimeToString(cx_TomorrowStr,'dd/mm/yyyy',cx_Tomorrow);
  DateTimeToString(cx_TodayStr,'dd/mm/yyyy',cx_Today);
  DateTimeToString(cx_DateFromStr,'dd/mm/yyyy',cx_DateFrom);
  result:=HTTP.Get(path);

HTTP.Free;
end;
}
(*
function NL_httpget(host : string; port : integer; path : string) : string;
 var
  sz_Url: PChar;
begin
 FillChar(cx_nlhr, SizeOf(cx_nlhr), #0);
 cx_nlhr.cbSize:=SizeOf(cx_nlhr);
 cx_nlhr.requestType:=REQUEST_GET;
 cx_nlhr.flags:={NLHRF_SMARTAUTHHEADER or NLHRF_NODUMPHEADERS or }NLHRF_DUMPASTEXT or NLHRF_HTTP11;
 StrPCopy(sz_Url, host{+':'+IntToStr(port)}+path);
 cx_nlhr.szUrl:=sz_Url;
 {
 cx_nlhr.headersCount:=4;
 cx_nlhr.headers:=mir_alloc(sizeof(TNETLIBHTTPHEADER)*cx_nlhr.headersCount);
 //SetLength(cx_nlhr.headers, 4);
 cx_nlhr.headers[0].szName  := 'User-Agent';
 cx_nlhr.headers[0].szValue := 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)';
 cx_nlhr.headers[1].szName  := 'Connection';
 cx_nlhr.headers[1].szValue := 'close';
 cx_nlhr.headers[2].szName  := 'Cache-Control';
 cx_nlhr.headers[2].szValue := 'no-cache';
 cx_nlhr.headers[3].szName  := 'Pragma';
 cx_nlhr.headers[3].szValue := 'no-cache';
 }
 ShowMessage('Call service with '+cx_nlhr.szUrl);
 try
  PluginLink^.CallService(MS_NETLIB_HTTPTRANSACTION, cx_hNetLibUser, DWORD(@cx_nlhr));
  //cx_nlhrReply:=PNETLIBHTTPREQUEST(PluginLink^.CallService(MS_NETLIB_HTTPTRANSACTION, cx_hNetLibUser, DWORD(@cx_nlhr)));
 except
  on E: Exception do
   begin
    MessageDlg(E.Message, mtError, [mbOK], 0);
    cx_nlhrReply:=nil;
   end;
 end;
 //SetLength(cx_nlhr.headers, 0);
 //mir_free(cx_nlhr.headers);
 if Assigned(cx_nlhrReply) then
  begin
   ShowMessage('Called 1!');
   Result:=StrPas(cx_nlhrReply^.pData);
   PluginLink^.CallService(MS_NETLIB_FREEHTTPREQUESTSTRUCT, 0, DWORD(cx_nlhrReply));
   ShowMessage('Called 2!');
  end
 else
  begin
   Result:='';
   ShowMessage('Failed!');
  end;
end;
*)

procedure HTTP_NL_Init();
 var
  cx_NetLibUser: TNETLIBUSER;
begin
  FillChar(cx_NetLibUser, sizeof(TNETLIBUSER), 0);
  cx_NetLibUser.cbSize := sizeof(TNETLIBUSER);
	cx_NetLibUser.flags := NUF_OUTGOING or NUF_HTTPCONNS or NUF_NOHTTPSOPTION;
	cx_NetLibUser.szSettingsModule := piShortName;
	cx_NetLibUser.szDescriptiveName.a := Translate(cx_ConnectionDescription);
  //ShowMessage(cx_NetLibUser.szDescriptiveName.a);
  cx_hNetLibUser := pluginLink^.CallService(MS_NETLIB_REGISTERUSER, 0, DWORD(@cx_NetLibUser));
  Netlib_Log(cx_hNetLibUser, PChar('Netlib service registered.'));
end;

function HTTP_NL_Get(szUrl: String; szRequestType: Integer = REQUEST_GET): String;
var nlhr: TNETLIBHTTPREQUEST;
    nlhrReply: PNETLIBHTTPREQUEST;
    szRedirUrl: String;
    i: Integer;
    szHost: String;
    //CookiesText: String;
begin
  result := ' ';

  // create 'storage' for cookies
  {
  if Not Assigned(CookiesGlobal) Then
  Begin
    CookiesGlobal := TStringList.Create;
    CookiesGlobal.Sorted := True;
    CookiesGlobal.Duplicates := dupIgnore;
    CookiesGlobal.Delimiter := ' ';
  End;
  }

  FillChar(nlhr, sizeof(nlhr), 0);
  nlhrReply := @nlhr;

  // initialize the netlib request
  nlhr.cbSize := sizeof(nlhr);
  nlhr.requestType := szRequestType; // passed from the function parameters, REQUEST_GET is default
  nlhr.flags := NLHRF_DUMPASTEXT or NLHRF_HTTP11;
  nlhr.szUrl := PChar(szUrl);
  nlhr.headers := nil;
  nlhr.headersCount := 0;
  {
  nlhr.headersCount := 4;
  SetLength(nlhr.headers, 4);
  nlhr.headers[0].szName  := 'User-Agent';
  nlhr.headers[0].szValue := 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)';
  nlhr.headers[1].szName  := 'Connection';
  nlhr.headers[1].szValue := 'Keep-Alive';
  nlhr.headers[2].szName  := 'Cache-Control';
  nlhr.headers[2].szValue := 'no-cache';
  nlhr.headers[3].szName  := 'Pragma';
  nlhr.headers[3].szValue := 'no-cache';
  }
  //nlhr.headers[4].szName  := 'Cookie';
  //CookiesText := CookiesGlobal.DelimitedText;
  //nlhr.headers[4].szValue := PChar(CookiesGlobal.DelimitedText);


  while (Result = ' ') do
  begin

    // fast exit when Miranda terminating
    if (PluginLink^.CallService(MS_SYSTEM_TERMINATED, 0, 0) = 1) then
    begin
       Result := '';
       Exit;
    end;

    //Netlib_Log(cx_hNetLibUser, PChar('(HTTP_NL_Get) Dowloading page: '+ szUrl));

    // download the page
    nlhrReply := PNETLIBHTTPREQUEST(PluginLink^.CallService(MS_NETLIB_HTTPTRANSACTION, {Windows.WParam}(cx_hNetLibUser), DWORD(@nlhr)));
    if (nlhrReply <> nil) Then
    Begin
      // read cookies & store it
      {
      For i:=0 To nlhrReply.headersCount-1 Do
      Begin
        // read cookie
        if nlhrReply.headers[i].szName = 'Set-Cookie' then
        Begin
          if Pos('remixlang=', nlhrReply.headers[i].szValue) > 0 Then
            // parsing works correctly only with Russian version, so replace
            // all other languages to Russian
            CookiesGlobal.Add('remixlang=0;')
          Else
            CookiesGlobal.Add(Copy(nlhrReply.headers[i].szValue, 0, Pos(';', nlhrReply.headers[i].szValue)));
        End;
      End;
      }

      // if the recieved code is 200 OK
      if (nlhrReply.resultCode = 200) then
      begin
        //ConnectionErrorsCount := 0;
        // save the retrieved data
        Result := nlhrReply.pData;
        if nlhrReply.dataLength = 0 Then
          Result := ''; // DATA_EMPTY;
      end
      // if the recieved code is 302 Moved, Found, etc
      // workaround for url forwarding
      else if (nlhrReply.resultCode = 302) and // page moved
              (szRequestType <> REQUEST_HEAD) then  // no need to redirect if REQUEST_HEAD
      begin
        //ConnectionErrorsCount := 0;
        // get the url for the new location and save it to szInfo
        // look for the reply header "Location"
        For i:=0 To nlhrReply.headersCount-1 Do
        begin
          if nlhrReply.headers[i].szName = 'Location' then
          begin
            // gap: the code below will not work correctly in some cases
            // if location url doesn't contain host name, we should add it
            szHost := Copy(szUrl, Pos('://',szUrl)+3, LastDelimiter('/', szUrl)-Pos('://',szUrl)-3);
            if Pos(szHost, nlhrReply.headers[i].szValue) = 0 Then
            begin
              if (RightStr(szHost, 1) <> '/') and (LeftStr(nlhrReply.headers[i].szValue, 1) <> '/') then
                szHost := szHost + '/';
              szRedirUrl := 'http://' + szHost + nlhrReply.headers[i].szValue
            end
            Else
              szRedirUrl := nlhrReply.headers[i].szValue;


            nlhr.szUrl := PChar(szRedirUrl);


            if Pos('http://pda.vkontakte.ru/index', szRedirUrl) = 0 then // block this page to support invisible mode
              Result := HTTP_NL_Get(szRedirUrl)                          // not the best solution
            else
              Result := 'div class="menu2"';


            CallService(MS_NETLIB_FREEHTTPREQUESTSTRUCT, 0, lParam(@nlhrReply));
            Exit;
          end
        end;
      end
      // return error code if the recieved code is neither 200 OK nor 302 Moved
      else
      begin
        {
        // change status of the protocol to offline
        Inc(ConnectionErrorsCount);
        if ConnectionErrorsCount = 2 then // disconnect only when second attemp unsuccessful
        begin
          ConnectionErrorsCount := 0;
          vk_SetStatus(ID_STATUS_OFFLINE);
        end;
        }
        // store the error code
        Result:='Error occured! HTTP Error!';
      end
    end
    // if the data does not downloaded successfully (ie. disconnected), then return error
    else
    begin
      {
      // change status of the protocol to offline
      Inc(ConnectionErrorsCount);
      if ConnectionErrorsCount = 2 then // disconnect only when second attemp unsuccessful
      begin
        ConnectionErrorsCount := 0;
        vk_SetStatus(ID_STATUS_OFFLINE);
      end;
      }
      // store the error code
      Result:='NetLib error occurred!';
    end;
  end;
end;

procedure HTTP_NL_Close();
begin
 if cx_hNetLibUser<>0 then
  begin
   pluginLink^.CallService(MS_NETLIB_CLOSEHANDLE, cx_hNetLibUser, 0);
   cx_hNetLibUser:=0;
  end;
end;

end.

